perm filename PICHAF.SAI[PIX,HPM] blob sn#426069 filedate 1979-03-14 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "PICHAF"
C00010 ENDMK
C⊗;
BEGIN "PICHAF"
REQUIRE "VIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
DO
  BEGIN "PICBLK"
  DEFINE WID=1600, HIG=1200;
  INTEGER SAFE ARRAY PIC[0:PIXDIM(HIG,WID+36,1)];

  INTEGER I,J,K,L,M,PL,LN;  STRING PFL;
  INTEGER SAFE ARRAY PC[0:10],BUF[0:20];
  INTEGER COUNT,BRCHAR,EOF,CH; BOOLEAN FLAG;

  MAKPIX(HIG,WID+36,1,PIC[0]);
  PRINT("Picture file:");  PFL←INCHWL; GETPFD(PFL,PC[0]);

  CH←GETCHAN; PRSFIL(PFL); EOF←TRUE;
  OPEN(CH,DEVPRS,'10,19,0,COUNT,BRCHAR,EOF);
  IF ¬EOF THEN LOOKUP(CH,FILPRS,FLAG);
  IF FLAG ∨ EOF THEN
     BEGIN
     RELEASE(CH);
     PRINT("Picture file ",PFL," not found",'15&'12);
     DONE "PICBLK";
     END;
   ARRYIN(CH,BUF[0],10);
   IF BUF[0]=-1 THEN
     BEGIN "new HE format"
     ARRYIN(CH,BUF[10],9);
     I←'200;
       comment in case file is MIT pseudo stanford format, and has no pointers;
     FOR K←18,17,16,15,10,9,8,7 DO IF BUF[K]≠0 THEN I←BUF[K];
     PC[BYBI]←BUF[1];
     PC[LNBY]←BUF[6]-BUF[5]+1;
     PC[PCLN]←BUF[4]-BUF[3]+1;
     PC[WDBY]←36%PC[BYBI];
     PC[LNWD]←BUF[2];
     PC[LNBYA]←PC[LNWD]*PC[WDBY];
     PC[PCWD]←PC[PCLN]*PC[LNWD];
     PC[PCBY]←PC[PCLN]*PC[LNBY];
     PC[PCBYA]←PC[PCLN]*PC[LNBYA];
     PC[WDBI]←PC[WDBY]*PC[BYBI];
     I←(I LAND '777777);
     FOR J←19 STEP 1 UNTIL I-1 DO WORDIN(CH); comment skip to first scanline;
     END
   ELSE
     BEGIN   comment if old hand eye format;
     PC[BYBI]←BUF[2];
     PC[LNBY]←BUF[8]-BUF[7]+1;
     PC[PCLN]←BUF[6]-BUF[5]+1;
     PC[WDBY]←36%PC[BYBI];
     PC[LNWD]←(PC[LNBY]+PC[WDBY]-1)%PC[WDBY];
     PC[LNBYA]←PC[LNWD]*PC[WDBY];
     PC[PCWD]←PC[PCLN]*PC[LNWD];
     PC[PCBY]←PC[PCLN]*PC[LNBY];
     PC[PCBYA]←PC[PCLN]*PC[LNBYA];
     PC[WDBI]←PC[WDBY]*PC[BYBI];
     IF PC[BYBI]≤0 ∨ PC[BYBI]>36 ∨ PC[LNBY]≤0 ∨ PC[PCLN]≤0 ∨ BUF[0]<0 THEN
       BEGIN
       RELEASE(CH);
       PRINT(" ",PFL," is not a picture file",'15&'12);
       DONE "PICBLK";
       END;
     END;

     BEGIN
     PRELOAD_WITH 5.7@-1,6.68@-1,6.68@-1,5.7@-1,4.31@-1,3.32@-1,3.32@-1,4.31@-1,
		  6.68@-1,9.05@-1,9.05@-1,6.68@-1,3.32@-1,9.47@-2,9.47@-2,3.32@-1,
		  6.68@-1,9.05@-1,9.05@-1,6.68@-1,3.32@-1,9.47@-2,9.47@-2,3.32@-1,
		  5.7@-1,6.68@-1,6.68@-1,5.7@-1, 4.31@-1,3.32@-1,3.32@-1,4.31@-1,
		  4.31@-1,3.32@-1,3.32@-1,4.31@-1,5.7@-1, 6.68@-1,6.68@-1,5.7@-1,
		  3.32@-1,9.47@-2,9.47@-2,3.32@-1,6.68@-1,9.05@-1,9.05@-1,6.68@-1,
		  3.32@-1,9.47@-2,9.47@-2,3.32@-1,6.68@-1,9.05@-1,9.05@-1,6.68@-1,
		  4.31@-1,3.32@-1,3.32@-1,4.31@-1,5.7@-1, 6.68@-1,6.68@-1,5.7@-1;
     OWN SAFE REAL ARRAY EGG1[0:63];
     PRELOAD_WITH .614, .728,  .614, .386, .272, .386,
		  .728, .956,  .728, .272, .044, .272,
		  .614, .728,  .614, .386, .272, .386,
		  .386, .272,  .386, .614, .728, .614,
		  .272, .044,  .272, .728, .956, .728,
		  .386, .272,  .386, .614, .728, .614;
     OWN REAL SAFE ARRAY EGG[0:35];  REAL SAFE ARRAY OMLET[0:35];

     INTEGER SAFE ARRAY SCNLIN[0:PC[LNWD]-1],BPTS,BPTD[0:WID-1];
     REAL SAFE ARRAY ERRS[-1:WID];

     PRELOAD_WITH  .9375,.1875,.4375,.6875,.75,0,.25,.5,
    .8125,.0625,.3125,.5625,.875,.125,.375,.625; OWN REAL SAFE ARRAY H[0:15];

     REAL PROCEDURE SGN(REAL X); RETURN(IF X<0 THEN -1 ELSE IF X>0 THEN 1 ELSE 0);

     L←POINT(1,MEMORY[PIC[LINTAB]+1],-1);
     FOR J←0 STEP 1 UNTIL WID-1 DO
       BEGIN
       K←J*PC[LNBY]%WID;
       BPTS[J]←POINT(PC[BYBI],SCNLIN[K%PC[WDBY]],((K MOD PC[WDBY])+1)*PC[BYBI]-1);
       IBP(L); BPTD[J]←L;
       END;
     FOR I←0 STEP 1 UNTIL 35 DO BEGIN OMLET[I]←2*EGG[I]-1;
comment  OMLET[I]←SGN(OMLET[I])*(ABS(OMLET[I]))↑0.1;
        IF OMLET[I]<0 THEN OMLET[I]←-2;
        OMLET[I]←(OMLET[I]+1)/2; END;
     FOR I←0 STEP 1 UNTIL 35 DO
        BEGIN IF (I MOD 6)=0 THEN PRINT('15&'12); PRINT(OMLET[I]); END;
     PRINT('15&'12);

     PL←-1;
     FOR I←0 STEP 1 UNTIL HIG-1 DO
	BEGIN
        INTEGER II,IL;
        REAL ERP;
	LN←I*PC[PCLN]%HIG;
        FOR PL←PL STEP 1 UNTIL LN DO ARRYIN(CH,SCNLIN[0],PC[LNWD]);
        II←(I MOD 6)*6;  IL←PIC[LNWD]*I; ERP←0;
	FOR J←0 STEP 1 UNTIL WID-1 DO
          BEGIN
          REAL ER;
          ER←ERRS[J]+1-LDB(BPTS[J])/PC[BMAX];
          IF ER>OMLET[II+(J MOD 6)] THEN
             BEGIN DPB(1,BPTD[J]+IL); ER←ER-2; END;
          ER←ER*0.25;
	  ERRS[J]←ER+ERP;
	  ERRS[J-1]←ERRS[J-1]+ER;
	  ERRS[J+1]←ERRS[J+1]+ER*1.5;
	  ERP←ER*0.5;
          END;
	END;
     RELEASE(CH);
     PUTPFL(PIC[0],"DSK:FOO.TMP[TMP,HPM]");
     VIDXGP(PIC[0],100,(1620-WID)%2,HIG+200);
     VIDXGP(PIC[0],100,(1620-WID)%2,HIG+200);
     END;
   END "PICBLK" UNTIL TRUE;
END "PICHAF";